unit upachid;

(* cpcPaChi - Un compilador de Pascal chiquitito para CPC
   Por Nacho Cabanes
   
   uPachiD - unidad "Data Structures" (estructuras de datos)
   
   Versiones hasta la fecha:
   
   Num.   Fecha       Cambios
   ---------------------------------------------------
   0.18  24-Ago-2008  Permite insertar (y leer) variables
                        de tipo "integer".
                      Todos los mensajes de error se apoyan
                        en "errorFatal"

   0.17  20-Ago-2008  Se pueden insertar funciones
                        predefinididas en la tabla de s.

   0.14  12-Ago-2008  Se pueden insertar procedimientos
                        en la tabla de simbolos

   0.13  09-Ago-2008  El error de "constante inexistente"
                        detalla de cual se trata.

   0.12  07-Ago-2008  Corregido un error en las etiq
                        para saltos: solo se modificaba
                        la ultima

   0.11  05-Ago-2008  Permite insertar etiquetas para
                        saltos
   
   0.10  25-Jun-2008  Permite insertar variables
                      Incluido "leerSimboloTS" para
                        ver si un simbolo no existe
                        en la tabla de simbolos
   
   0.07  06-Abr-2008  Primera version
                      Incluye la estructura Token
                      Incluye la estructura Simbolo
                      Permite insertar y leer constantes

*)


interface

  const
    numSimbolos: integer = 0;

    MAXSIMBOLOS = 200;
    
    tCONST = 1; (* Dato CONST -constante- en tabla de simbolos *)
    tVAR = 2;   (* Dato VAR -variable- en tabla de simbolos *)
    tLABEL = 3; (* Dato LABEL -etiqueta- en tabla de simbolos *)
    tPROC = 4;  (* Dato PROCEDURE -procedimiento- en tabla de simbolos *)
    tFUNC = 5;  (* Dato FUNCTION -funcion- en tabla de simbolos *)
    
    tINEXIST = 0; (* Dato no existente en tabla de simbolos *)
    
    tSINTIPO = 0;  (* Dato sin tipo (todavia), para analizar los "VAR" *)
    tBYTE = 1;     (* Tipo byte, de 1 byte de longitud *)
    tINTEGER = 2;  (* Tipo integer, de 2 bytes *)
    
    (* Tipos de tokens *)
    tkRESERV = 0; (* Palabra reservada - No se usa aun- *)
    tkID = 1;     (* Identificador *)
    tkPARI = 2;   (* Parent Izqdo: ( *)
    tkPARD = 3;   (* Parent Decho: ) *)
    tkPYC = 4;    (* Punto y coma: ; *)
    tkDOSP = 5;   (* Dos puntos: : *)
    tkIGUAL = 6;  (* Igual: = *)
    tkASIGN = 7;  (* Asignacion: := *)
    tkCOMA = 8;   (* Coma: , *)
    tkPUNTO = 9;  (* Punto: . *)
    tkMENOR = 10; (* Menor que: < *)
    tkMAYOR = 11; (* Mayor que: > *)
    tkMENORI = 12; (* Menor o igual que: <= *)
    tkMAYORI = 13; (* Mayor o igual que: >= *)
    tkDISTINTO = 14; (* Distinto de: <> *)
    tkCOMILLA = 15;  (* Comilla simple: ' *)
    tkENTERO = 20;  (* Numero entero *)


  type token =
    record
      tipo: integer;
      valor: string;
      posx,posy: integer;
    end;

  type simbolo =
    record
      nombre: string;    (* Nombre del simbolo *)
      constVar: integer; (* Si es CONST o VAR *)
      tipoDato: integer; (* Tipo base: BYTE, etc *)
      valorDir: string;  (* Valor o direccion *)
    end;
    
  var
    listaSimbolos: array[1..MAXSIMBOLOS] of simbolo;


  function mayusc(s: string): string;

  procedure insertarSimboloConst(nombreConst: string; valorConst: string);
  procedure insertarSimboloProcedure(nombreProc: string; direccion: string);
  procedure insertarSimboloVar(nombreVar: string; tipoVar: byte);
  procedure insertarSimboloFunc(nombreFunc: string; tipoVar: byte);
  procedure indicarTiposVar(tipoVar: byte);
  procedure insertarSimboloLabel(nombreLabel: string);
  procedure insertarDireccionLabel(nombreLabel: string; direccion: string);
  function leerSimboloTS(nombre: string): byte;
  function leerTipoDatoTS(nombre: string): byte;
  function leerSimboloConst(nombreConst: string): integer;
  function leerSimboloVar(nombreVar: string): integer;
  function leerSimboloLabel(nombreLabel: string): integer;
  
  function validarByte(t: token): boolean;
  function validarByteNombre(n: string): boolean;

implementation

  uses uPachiG; {, uPaChiL;}
  function mayusc(s: string): string;
  var
    t: string;
    i: byte;
  begin
    t := s;
    for i:= 1 to length(t) do
      t[i] := upcase(t[i]);
    mayusc := t;
  end;

  (* Muestra un mensaje de error y abandona el programa *)
  procedure errorFatal(mensaje: string);
  begin
     writeln(mensaje);
     halt;
  end;

  (* Guardar una constante en la tabla de simbolos *)
  procedure insertarSimboloConst(nombreConst: string; valorConst: string);
  var
    i: integer;
  begin
    nombreConst := mayusc(nombreConst);
    (* Primero comprobamos si el simbolo ya existe *)
    for i:=1 to numSimbolos do
      if listaSimbolos[i].nombre = nombreConst then
          errorFatal('Constante repetida: '+ nombreConst);
    (* Si no existe, lo insertamos *)
    numSimbolos := numSimbolos + 1;
    if numSimbolos > maxSimbolos then
      errorFatal('Tabla de simbolos llena!');
    listaSimbolos[numSimbolos].nombre := nombreConst;
    listaSimbolos[numSimbolos].constVar := tCONST;
    listaSimbolos[numSimbolos].tipoDato := tBYTE;
    listaSimbolos[numSimbolos].valorDir := valorConst;
  end;

  (* Guardar un procedimiento en la tabla de simbolos *)
  procedure insertarSimboloProcedure(nombreProc: string; direccion: string);
  var
    i: integer;
  begin
    nombreProc := mayusc(nombreProc);
    (* Primero comprobamos si el simbolo ya existe *)
    for i:=1 to numSimbolos do
      if listaSimbolos[i].nombre = nombreProc then
        errorFatal('Identificador repetido: '+nombreProc+'!');
    (* Si no existe, lo insertamos *)
    numSimbolos := numSimbolos + 1;
    if numSimbolos > maxSimbolos then
      errorFatal('Tabla de simbolos llena!');
    listaSimbolos[numSimbolos].nombre := nombreProc;
    listaSimbolos[numSimbolos].constVar := tPROC;    
    listaSimbolos[numSimbolos].valorDir := direccion;
  end;

  
  (* Guardar una variable en la tabla de simbolos *)
  procedure insertarSimboloVar(nombreVar: string; tipoVar: byte);
  var
    i: integer;
  begin
    nombreVar := mayusc(nombreVar);
    (* Primero comprobamos si el simbolo ya existe *)
    for i:=1 to numSimbolos do
      if listaSimbolos[i].nombre = nombreVar then
        errorFatal('Identificador repetido: VAR '+nombreVar+'!');
    (* Si no existe, lo insertamos *)
    numSimbolos := numSimbolos + 1;
    if numSimbolos > maxSimbolos then
      errorFatal('Tabla de simbolos llena!');
    listaSimbolos[numSimbolos].nombre := nombreVar;
    listaSimbolos[numSimbolos].constVar := tVAR;    
    if tipoVar = tByte then
      begin
      listaSimbolos[numSimbolos].tipoDato := tBYTE;
      (* Direccion, en vez de valor *)
      str(proximaDireccionLibre(tBYTE),
        listaSimbolos[numSimbolos].valorDir); 
      end
    else if tipoVar = tInteger then
      begin
      listaSimbolos[numSimbolos].tipoDato := tInteger;
      (* Direccion, en vez de valor *)
      str(proximaDireccionLibre(tInteger),
        listaSimbolos[numSimbolos].valorDir); 
      end
    else if tipoVar = tSINTIPO then
      begin
      listaSimbolos[numSimbolos].tipoDato := tSINTIPO;
      end
    else
      errorFatal('Tipo de datos desconocido!');
      
    {Lo siguiente es para ayudar en depuracion:
    
    writeln('Insertado:');
    writeln(listaSimbolos[numSimbolos].nombre);
    writeln(listaSimbolos[numSimbolos].tipoDato);
    writeln(listaSimbolos[numSimbolos].valorDir);
    readln;}
  end;

  (* Guardar una funcion en la tabla de simbolos *)
  procedure insertarSimboloFunc(nombreFunc: string; tipoVar: byte);
  var
    i: integer;
  begin
    nombreFunc := mayusc(nombreFunc);
    (* Primero comprobamos si el simbolo ya existe *)
    for i:=1 to numSimbolos do
      if listaSimbolos[i].nombre = nombreFunc then
        errorFatal('Identificador repetido: Function '+nombreFunc+'!');
    (* Si no existe, lo insertamos *)
    numSimbolos := numSimbolos + 1;
    if numSimbolos > maxSimbolos then
      errorFatal('Tabla de simbolos llena!');
    listaSimbolos[numSimbolos].nombre := nombreFunc;
    listaSimbolos[numSimbolos].constVar := tFUNC;
    if tipoVar = tByte then
      begin
      listaSimbolos[numSimbolos].tipoDato := tBYTE;
      (* Sin direccion, en vez de valor *)
      end
    else if tipoVar = tSINTIPO then
      begin
      listaSimbolos[numSimbolos].tipoDato := tSINTIPO;
      end
    else
      errorFatal('Tipo de datos desconocido!');    
  end;
  
  
  
  (* Para declaraciones como var x,y,z: byte; indicar los tipos
     de las variables que se acaban de leer  *)
  procedure indicarTiposVar(tipoVar: byte);
  var
    i: integer;
  begin
    (* Primero comprobamos si el simbolo ya existe *)
    for i:=1 to numSimbolos do
      begin
      if (listaSimbolos[i].constVar = tVAR) 
        and (listaSimbolos[i].tipoDato = tSINTIPO) 
      then
        begin
          {if tipoVar = tByte then}
            begin
            listaSimbolos[i].tipoDato := tipoVar;
            (* Direccion, en vez de valor *)
            str(proximaDireccionLibre(tipoVar),
              listaSimbolos[i].valorDir); 
            end;
        end;
      end;
  end;


  (* Guardar una etiqueta de salto en la tabla de simbolos *)
  procedure insertarSimboloLabel(nombreLabel: string);
  var
    i: integer;
  begin
    nombreLabel := mayusc(nombreLabel);
    (* Primero comprobamos si el simbolo ya existe *)
    for i:=1 to numSimbolos do
      if listaSimbolos[i].nombre = nombreLabel then
        errorFatal('Identificador repetido: LABEL '+nombreLabel+'!');
    (* Si no existe, lo insertamos *)
    numSimbolos := numSimbolos + 1;
    if numSimbolos > maxSimbolos then
      errorFatal('Tabla de simbolos llena!');
    listaSimbolos[numSimbolos].nombre := nombreLabel;
    listaSimbolos[numSimbolos].constVar := tLABEL;    
    listaSimbolos[numSimbolos].tipoDato := tINTEGER;
    (* Direccion, en vez de valor *)
    listaSimbolos[numSimbolos].valorDir := '0'; 
  end;


  (* Guardar una la direccion de etiqueta de salto en la tabla de simbolos *)
  procedure insertarDireccionLabel(nombreLabel: string; direccion: string);
  var
    i: integer;
  begin  
    nombreLabel := mayusc(nombreLabel);
    for i:=1 to numSimbolos do
      begin
      if listaSimbolos[i].nombre = nombreLabel then
        begin
        listaSimbolos[i].valorDir := direccion; 
        end;
      end;
  end;


  (* Leer una simbolo de la tabla de simbolos *)
  function leerSimboloTS(nombre: string): byte;
  var
    i: integer;
    tipoSimbolo: byte;
  begin
    tipoSimbolo := tINEXIST;
    nombre := mayusc(nombre);
    (* Primero comprobamos si el simbolo ya existe *)
    for i:=1 to numSimbolos do
      begin
      if listaSimbolos[i].nombre = nombre then
        begin
          if listaSimbolos[i].constVar = tCONST
            then tipoSimbolo := tCONST;
          if listaSimbolos[i].constVar = tVAR
            then tipoSimbolo := tVAR;
          if listaSimbolos[i].constVar = tLABEL
            then tipoSimbolo := tLABEL;
          if listaSimbolos[i].constVar = tPROC
            then tipoSimbolo := tPROC;
          if listaSimbolos[i].constVar = tFUNC
            then tipoSimbolo := tFUNC;
        end;
      end;
    leerSimboloTS := tipoSimbolo;
  end;

  function leerTipoDatoTS(nombre: string): byte;
  var
    i: integer;
    tipoSimbolo: byte;
  begin
    tipoSimbolo := tSINTIPO;
    nombre := mayusc(nombre);
    (* Primero comprobamos si el simbolo ya existe *)
    for i:=1 to numSimbolos do
      begin
      if listaSimbolos[i].nombre = nombre then
        begin
          if listaSimbolos[i].tipoDato = tBYTE
            then tipoSimbolo := tBYTE;
          if listaSimbolos[i].tipoDato = tINTEGER
            then tipoSimbolo := tINTEGER;
        end;
      end;
    leerTipoDatoTS := tipoSimbolo;
  end;

  
  (* Leer una constante de la tabla de simbolos *)
  function leerSimboloConst(nombreConst: string): integer;
  var
    encontrado: boolean;
    i: integer;
    x: byte;
    codError: integer;
  begin
    nombreConst := mayusc(nombreConst);
    encontrado := false;
    (* Primero comprobamos si el simbolo ya existe *)
    for i:=1 to numSimbolos do
      begin
      if listaSimbolos[i].nombre = nombreConst then
        begin
          val(listaSimbolos[i].valorDir, x, codError);
          if codError <> 0 then errorFatal('Constante no numerica');
          leerSimboloConst := x;
          encontrado := true;
        end;
      end;
    (* Si no existe, mensaje de error *)
    if encontrado = false then
          errorFatal('Constante inexistente: '+nombreConst+'!');
  end;

  (* Leer la direcc de una variable de la tabla de simbolos *)
  function leerSimboloVar(nombreVar: string): integer;
  var
    encontrado: boolean;
    i: integer;
    x: integer;
    codError: integer;
  begin
    nombreVar := mayusc(nombreVar);
    encontrado := false;
    (* Primero comprobamos si el simbolo ya existe *)
    for i:=1 to numSimbolos do
      begin
      if listaSimbolos[i].nombre = nombreVar then
        begin
          val(listaSimbolos[i].valorDir, x, codError);
          if codError <> 0 then errorFatal('Direccion no numerica: '
            + listaSimbolos[i].valorDir);
          leerSimboloVar := x;
          encontrado := true;
        end;
      end;
    (* Si no existe, mensaje de error *)
    if encontrado = false then
          errorFatal('Variable inexistente: '+nombreVar+'!');
  end;
  
  (* Leer la direcc de una etiqueta -de salto- de la tabla de simbolos *)
  function leerSimboloLabel(nombreLabel: string): integer;
  var
    encontrado: boolean;
    i: integer;
    x: integer;
    codError: integer;
  begin
    nombreLabel := mayusc(nombreLabel);
    encontrado := false;
    (* Primero comprobamos si el simbolo ya existe *)
    for i:=1 to numSimbolos do
      begin
      if listaSimbolos[i].nombre = nombreLabel then
        begin
          val(listaSimbolos[i].valorDir, x, codError);
          if codError <> 0 then errorFatal('Direccion no numerica');
          leerSimboloLabel := x;
          encontrado := true;
        end;
      end;
    (* Si no existe, mensaje de error *)
    if encontrado = false then
          errorFatal('Etiqueta inexistente: '+nombreLabel+'!');
  end;  
  
  (* Devuelve TRUE si el dato es de tipo BYTE, FALSE si no lo es *)
  function validarByte(t: token): boolean;
  var
    valorInt, codError: integer;
    tipoDato: byte;
    valido: boolean;
  begin
    valido := true;
    if (t.tipo = tkENTERO) then
      begin
      val(t.valor, valorInt, codError);
      if (valorInt < 0) or (valorInt > 255) or (codError <> 0) then      
        valido := false;
      end;  
    if (t.tipo <> tkENTERO) then
      begin
      tipoDato := leerTipoDatoTS(t.valor);
      if tipoDato <> tByte then      
        valido := false;
      end;  
    validarByte := valido;
  end;

  (* Devuelve TRUE si el dato es de tipo BYTE, FALSE si no lo es *)
  function validarByteNombre(n: string): boolean;
  var
    valorInt, codError: integer;
    tipoDato: byte;
    valido: boolean;
  begin
    valido := true;
    val(n, valorInt, codError);
    if codError = 0 then
      begin
      if (valorInt < 0) or (valorInt > 255) then      
        valido := false;
      end;  
    if codError <> 0 then
      begin
      tipoDato := leerTipoDatoTS(n);
      if tipoDato <> tByte then      
        valido := false;
      end;  
    validarByteNombre := valido;
  end;

  
begin
end.
